home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol048 / dltaprnt.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  13.4 KB  |  302 lines
  1. 10  ' PGM NAME: DLTAPRNT.BAS      WRITTEN 9-4-1983     REV 9-16-1983
  2. 15 ' ******************************************************************
  3. 20 ' * MATRIX IDENTIFICATION AND DIMENSIONS                           *
  4. 25 ' ******************************************************************
  5. 30 '
  6. 35 DIM G$(80)
  7. 40 ' *****************************************************************
  8. 45 ' * MODULE 0                                                      *
  9. 50 ' * DRIVER MODULE                                                 *
  10. 55 ' *****************************************************************
  11. 60 '
  12. 65 CLS
  13. 70 PRINT "PROGRAM DLTAPRNT.BAS EXECUTING"
  14. 90 OPEN "A:DRIVE.DTA" FOR INPUT AS #1
  15. 100 INPUT #1, DRIVE$,PRNT$
  16. 110 CLOSE #1
  17. 120 IF DRIVE$ = "A" OR DRIVE$ = "a" THEN GOSUB 300 ELSE GOSUB 400
  18. 130 '
  19. 135 WIDTH "LPT1:",80            'SET LINE WIDTH TO 80
  20. 140 '  SET UP DEFAULT CONDITIONS FOR IBM OR EPSON PRINTER
  21. 150 IF PRNT$ = "E" OR PRNT$ = "e" THEN GOSUB 4200 ELSE GOSUB 4300
  22. 160 LPRINT CHR$(27); CHR$(48);          'SET FOR COMPRESSED LINES
  23. 165 '
  24. 170 GOSUB 1000                  'PRINT HDRS, PERFORM HOUSEKEEPING
  25. 175 '
  26. 180 END.NUM = END.NUM - REC.CNT
  27. 190 FOR I = 1 TO END.NUM
  28. 200         IF EOF(2) THEN GOTO 230
  29. 210         GOSUB 3000         'PROCESS INPUT RECORDS
  30. 220         NEXT
  31. 230 GOSUB 4000                 'PERFORM EOJ HOUSEKEEPING
  32. 240 END
  33. 300 ' *******************************************************************
  34. 310 ' * GOSUB 300                                                       *
  35. 320 ' * GET DATA FROM DRIVE A                                           *
  36. 330 ' *******************************************************************
  37. 340 '
  38. 350 PRINT "INSERT DATA DISKETTE IN DRIVE A"
  39. 355 PRINT "SET PRINTER TO TOP OF PAGE"
  40. 360 PRINT "VERIFY THAT PRINTER IS ON"
  41. 365 PRINT "STRIKE ANY KEY WHEN READY"
  42. 370 A$ = INKEY$: IF A$ = "" THEN 370
  43. 380 OPEN "A:DLTAFILE.DTA" FOR INPUT AS #2
  44. 390 RETURN
  45. 400 ' *******************************************************************
  46. 410 ' * GOSUB 400                                                       *
  47. 420 ' * GET DATA FROM DRIVE B                                           *
  48. 430 ' *******************************************************************
  49. 440 '
  50. 450 PRINT "INSERT DATA DISKETTE IN DRIVE B"
  51. 455 PRINT "SET PRINTER TO TOP OF PAGE"
  52. 460 PRINT "VERIFY THAT PRINTER IS ON"
  53. 465 PRINT "STRIKE ANY KEY WHEN READY"
  54. 470 A$ = INKEY$: IF A$ = "" THEN 470
  55. 480 OPEN "B:DLTAFILE.DTA" FOR INPUT AS #2
  56. 490 RETURN
  57. 1000 ' ****************************************************************
  58. 1002 ' * GOSUB 1000                                                   *
  59. 1004 ' * PRELIMINARY OPERATIONS                                       *
  60. 1008 ' ****************************************************************
  61. 1010 '
  62. 1015 INPUT #2, I.FILE.TITLE$,I.FILE.OWNER$,I.FILE.UPDATE.DATE$
  63. 1020 HDG1$ = I.FILE.OWNER$
  64. 1025 GOSUB 2000                         'SET UP HEADINGS
  65. 1030 GOSUB 2500                         'SET UP END.NUM AND SKIP.NUM
  66. 1035 IF SKIP.NUM <> 0 THEN GOSUB 2700   'SKIP INITIAL RECORDS
  67. 1038 '   END PROCESSING IF RECORD COUNT LIMIT REACHED
  68. 1040 IF REC.CNT > END.NUM THEN GOTO 230
  69. 1044 HDG2$ = "PORTFOLIO CHANGES"
  70. 1046 HDG3$ = "DOLLAR CHANGES"
  71. 1048 HDG4$ = "PERCENT CHANGES (UNITS)"
  72. 1050 LPRINT
  73. 1052 LPRINT TAB(3) HDG1$; TAB(35) HDG2$; TAB(70) DATE$
  74. 1054 LPRINT
  75. 1056 LPRINT TAB(16) HDG3$; TAB(57) HDG4$
  76. 1058 LPRINT
  77. 1060 LPRINT TAB(6) HDRA$; TAB(16) HDRB$; TAB(28) "0"; TAB(36) HDRC$; TAB(46) HDRD$; TAB(57) "-10"; TAB(62) "-5"; TAB(68) "0"; TAB(72) "+5"; TAB(77) "+10"
  78. 1062 LPRINT TAB(8) "v"; TAB(18) "v"; TAB(28) "v"; TAB(38) "v"; TAB(48) "v"; TAB(58) "v"; TAB(63) "v"; TAB(68) "v"; TAB(73) "v"; TAB(78) "v"
  79. 1064 GWEEK$ = "      "
  80. 1065 G$(0) = " "
  81. 1066 FOR I = 1 TO 80
  82. 1068         IF PRNT$ = "E" THEN G$(I) = CHR$(157) ELSE G$(I) = CHR$(196)
  83. 1070         NEXT
  84. 1072 GOSUB 3500                 'WRITE REC WITH G$ ELEMENTS
  85. 1074 GOSUB 3600                 'CLEAR G$ ELEMENTS TO SPACES
  86. 1076 RETURN
  87. 2000 ' ****************************************************************
  88. 2005 ' * GOSUB 2000                                                   *
  89. 2010 ' * SET UP GRAPH HEADINGS                                        *
  90. 2015 ' ****************************************************************
  91. 2020 '
  92. 2025 PRINT "SELECT GRAPH SCALE FROM FOLLOWING:"
  93. 2030 PRINT "     1 - $0 TO $1000 RANGE"
  94. 2035 PRINT "     2 - $0 TO $2000 RANGE"
  95. 2040 PRINT "     3 - $0 TO $4000 RANGE"
  96. 2045 PRINT "     4 - $0 TO $8000 RANGE"
  97. 2050 INPUT "GRAPH SCALE SELECTED IS  ", GSCALE
  98. 2060 IF GSCALE <= 0 OR GSCALE > 4 THEN BEEP: GOTO 2025
  99. 2065 ON GSCALE GOSUB 2100, 2200, 2300, 2400     'SET PER GRAPH SCALE
  100. 2070 RETURN
  101. 2100 ' ****************************************************************
  102. 2105 ' * GOSUB 2100                                                   *
  103. 2110 ' * SET FOR 0 TO 1000 GRAPH SCALE                                *
  104. 2115 ' ****************************************************************
  105. 2120 '
  106. 2125 HDRA$ = "-1000"
  107. 2130 HDRB$ = " -500"
  108. 2135 HDRC$ = " +500"
  109. 2140 HDRD$ = "+1000"
  110. 2145 SCALE.FACTOR = .02
  111. 2150 RETURN
  112. 2200 ' ****************************************************************
  113. 2205 ' * GOSUB 2200                                                   *
  114. 2210 ' * SET FOR 0 TO 2000 GRAPH SCALE                                *
  115. 2215 ' ****************************************************************
  116. 2220 '
  117. 2225 HDRA$ = "-2000"
  118. 2230 HDRB$ = "-1000"
  119. 2235 HDRC$ = "+1000"
  120. 2240 HDRD$ = "+2000"
  121. 2245 SCALE.FACTOR = .01
  122. 2250 RETURN
  123. 2300 ' ****************************************************************
  124. 2305 ' * GOSUB 2300                                                   *
  125. 2310 ' * SET FOR 0 TO 4000 GRAPH SCALE                                *
  126. 2315 ' ****************************************************************
  127. 2320 '
  128. 2325 HDRA$ = "-4000"
  129. 2330 HDRB$ = "-2000"
  130. 2335 HDRC$ = "+2000"
  131. 2340 HDRD$ = "+4000"
  132. 2345 SCALE.FACTOR = 5.000001E-03
  133. 2350 RETURN
  134. 2400 ' ****************************************************************
  135. 2405 ' * GOSUB 2400                                                   *
  136. 2410 ' * SET FOR 0 TO 8000 GRAPH SCALE                                *
  137. 2415 ' ****************************************************************
  138. 2420 '
  139. 2425 HDRA$ = "-8000"
  140. 2430 HDRB$ = "-4000"
  141. 2435 HDRC$ = "+4000"
  142. 2440 HDRD$ = "+8000"
  143. 2445 SCALE.FACTOR = .0025
  144. 2450 RETURN
  145. 2500 ' ****************************************************************
  146. 2505 ' * GOSUB 2500                                                   *
  147. 2510 ' * SET END.NUM AND SKIP.NUM LIMITS                              *
  148. 2515 ' ****************************************************************
  149. 2520 '
  150. 2525 INPUT "INPUT LIMIT ON NUMBER OF RECS TO BE PROCESSED  ", END.NUM
  151. 2530 PRINT
  152. 2535 INPUT "SOME INITIAL RECORDS TO BE SKIPPED (Y/N)"; SKIP$
  153. 2540 PRINT
  154. 2545 IF SKIP$ <> "Y" AND SKIP$ <> "y" THEN GOTO 2570
  155. 2550 '
  156. 2555 INPUT "INPUT COUNT OF INITIAL RECORDS TO BE SKIPPED  ", SKIP.NUM
  157. 2560 GOTO 2580
  158. 2565 '
  159. 2570 SKIP.NUM = 0
  160. 2575 '
  161. 2580 RETURN
  162. 2700 ' ********************************************************
  163. 2705 ' * GOSUB 2700                                           *
  164. 2710 ' * SKIP NUMBER OF RECORDS SPECIFIED BY SKIP.NUM         *
  165. 2715 ' ********************************************************
  166. 2720 '
  167. 2730 FOR I = 1 TO SKIP.NUM
  168. 2735    IF EOF(2) THEN GOTO 230
  169. 2740    INPUT #2,I.DATE$,I.NEW.DOLLAR,I.DOLLAR.DLTA
  170. 2745    REC.CNT = REC.CNT + 1
  171. 2750    NEXT
  172. 2755 RETURN
  173. 3000 ' ****************************************************************
  174. 3002 ' * GOSUB 3000                                                   *
  175. 3004 ' * READ FILE, COMPILE GRAPH REC, AND WRITE GRAPH REC            *
  176. 3006 ' ****************************************************************
  177. 3007 '
  178. 3008 INPUT #2, I.DATE$,I.NEW.DOLLAR,I.DOLLAR.DLTA
  179. 3009 GWEEK$ = I.DATE$
  180. 3010 OLD.DOLLAR = I.NEW.DOLLAR - I.DOLLAR.DLTA
  181. 3012 GOSUB 3200                 'SET GRAPH PARAMETERS TO SCALE
  182. 3014 GOSUB 3300                 'PREPARE NEW GRAPH LINE
  183. 3016 PERCENT.NUMERATOR = I.DOLLAR.DLTA * 100
  184. 3018 IF OLD.DOLLAR <> 0 THEN PERCENT.DLTA = PERCENT.NUMERATOR / OLD.DOLLAR ELSE PERCENT.DLTA = 0
  185. 3020 GOSUB 3400                 'ROUND OFF PARAMETERS TO INTEGERS
  186. 3022 IF I.DOLLAR.DLTA = 0 THEN G$(21) = "*" ELSE GOSUB 3028
  187. 3024 GOSUB 3050                 'PLACE PERCENT DELTA ON G$ LINE
  188. 3025 GOSUB 3500                 'WRITE REC WITH G$ ELEMENTS
  189. 3026 GOSUB 3600                 'CLEAR G$ ELEMENTS TO SPACES
  190. 3027 RETURN
  191. 3028 I.DOLLAR.DLTA = I.DOLLAR.DLTA + 21
  192. 3030 IF I.DOLLAR.DLTA > 21 THEN GOSUB 3034 ELSE GOSUB 3042
  193. 3032 RETURN
  194. 3034 FOR N = 22 TO I.DOLLAR.DLTA
  195. 3036         G$(N) = "$"
  196. 3038         NEXT
  197. 3040 RETURN
  198. 3042 FOR N = I.DOLLAR.DLTA TO 20
  199. 3044         G$(N) = "#"
  200. 3046         NEXT
  201. 3048 RETURN
  202. 3050 PERCENT.DLTA = PERCENT.DLTA + 61
  203. 3051 G$(PERCENT.DLTA) = "*"
  204. 3052 RETURN
  205. 3200 ' ****************************************************************
  206. 3205 ' * GOSUB 3200                                                   *
  207. 3210 ' * SET GRAPH PARAMETERS TO SCALE                                *
  208. 3220 ' ****************************************************************
  209. 3225 '
  210. 3230 I.DOLLAR.DLTA = I.DOLLAR.DLTA * SCALE.FACTOR
  211. 3235 OLD.DOLLAR = OLD.DOLLAR * SCALE.FACTOR
  212. 3250 RETURN
  213. 3300 ' ****************************************************************
  214. 3305 ' * GOSUB 3300                                                   *
  215. 3310 ' * PREPARE G$ ELEMENTS FOR NEW REC                              *
  216. 3320 ' ****************************************************************
  217. 3325 '
  218. 3330 G$(1) = ":"
  219. 3335 G$(11) = ":"
  220. 3340 IF PRNT$ = "E" THEN G$(21) = CHR$(156) ELSE G$(21) = CHR$(179)
  221. 3345 G$(31) = ":"
  222. 3350 G$(41) = ":"
  223. 3355 G$(51) = ":"
  224. 3360 G$(56) = ":"
  225. 3365 IF PRNT$ = "E" THEN G$(61) = CHR$(156) ELSE G$(61) = CHR$(179)
  226. 3370 G$(66) = ":"
  227. 3375 G$(71) = ":"
  228. 3380 RETURN
  229. 3400 ' ****************************************************************
  230. 3405 ' * GOSUB 3400                                                   *
  231. 3410 ' * ROUND OFF PARAMETERS TO INTEGERS                             *
  232. 3420 ' ****************************************************************
  233. 3425 '
  234. 3430 I.DOLLAR.DLTA = CINT(I.DOLLAR.DLTA)
  235. 3435 PERCENT.DLTA = CINT(PERCENT.DLTA)
  236. 3440 RETURN
  237. 3500 ' ****************************************************************
  238. 3505 ' * GOSUB 3500                                                   *
  239. 3510 ' * WRITE LINE CONSISTING OF G$ ELEMENTS                         *
  240. 3515 ' ****************************************************************
  241. 3520 '
  242. 3525 LPRINT GWEEK$;G$(0);G$(1);G$(2);G$(3);G$(4);G$(5);G$(6);G$(7);G$(8);G$(9);G$(10);
  243. 3530 LPRINT G$(11);G$(12);G$(13);G$(14);G$(15);G$(16);G$(17);G$(18);G$(19);G$(20);
  244. 3535 LPRINT G$(21);G$(22);G$(23);G$(24);G$(25);G$(26);G$(27);G$(28);G$(29);G$(30);
  245. 3540 LPRINT G$(31);G$(32);G$(33);G$(34);G$(35);G$(36);G$(37);G$(38);G$(39);G$(40);
  246. 3545 LPRINT G$(41);G$(42);G$(43);G$(44);G$(45);G$(46);G$(47);G$(48);G$(49);G$(50);
  247. 3550 LPRINT G$(51);G$(52);G$(53);G$(54);G$(55);G$(56);G$(57);G$(58);G$(59);G$(60);
  248. 3555 LPRINT G$(61);G$(62);G$(63);G$(64);G$(65);G$(66);G$(67);G$(68);G$(69);G$(70);
  249. 3560 LPRINT G$(71)
  250. 3565 RETURN
  251. 3600 ' ****************************************************************
  252. 3605 ' * GOSUB 3600                                                   *
  253. 3610 ' * CLEAR G ELEMENTS TO SPACES                                   *
  254. 3615 ' ****************************************************************
  255. 3616 '
  256. 3618 GWEEK$ = "      "
  257. 3620 FOR GS = 1 TO 71
  258. 3630     G$(GS) = " "
  259. 3635     NEXT
  260. 3640 RETURN
  261. 4000 ' ****************************************************************
  262. 4005 ' * GOSUB 4000                                                   *
  263. 4010 ' * EOJ HOUSEKEEPING                                             *
  264. 4015 ' ****************************************************************
  265. 4020 '
  266. 4025 CLOSE #2
  267. 4027 LPRINT CHR$(12);
  268. 4030 PRINT "ALL DATA PROCESSED - PROGRAM ENDS"
  269. 4035 WIDTH "LPT1:",80
  270. 4040 ' RESTORE PRINTER TO DEFAULT CONFIGURATION
  271. 4045 IF PRNT$ = "E" THEN GOSUB 4200 ELSE GOSUB 4300
  272. 4070 RETURN
  273. 4099 ' ****************************************************************
  274. 4200 '*****************************************************************
  275. 4205 '*   SET EPSON PRINTER TO DEFAULT CONDITION                      *
  276. 4210 '*****************************************************************
  277. 4215 '
  278. 4220 LPRINT CHR$(27); CHR$(64);         'TURN OFF ALL SPCL PRINTER CODES
  279. 4225 RETURN
  280. 4300 '*****************************************************************
  281. 4305 '*   SET IBM PRINTER TO DEFAULT CONDITIONS                       *
  282. 4310 '*****************************************************************
  283. 4315 '
  284. 4320 LPRINT CHR$(20);                   'DOUBLE WIDTH CHAR OFF
  285. 4325 LPRINT CHR$(18);                   'COMPRESSED CHAR OFF
  286. 4330 LPRINT CHR$(27); CHR$(50);         'DEFAULT LINE SPACING (1/6")
  287. 4335 LPRINT CHR$(27); CHR$(55);         'CHAR SET #1 SELECTED
  288. 4340 LPRINT CHR$(27); CHR$(57);         'PAPER OUT SWITCH ENABLED
  289. 4345 LPRINT CHR$(27); CHR$(70);         'EMPHASIZED CHAR OFF
  290. 4350 LPRINT CHR$(27); CHR$(72);         'DOUBLE STRIKE OFF
  291. 4355 LPRINT CHR$(27); CHR$(79);         'IGNORE SKIPS OVER PERFS
  292. 4360 LPRINT CHR$(27); CHR$(85); CHR$(0);  'SELECT BIDIRECTIONAL PRINT
  293. 4365 LPRINT CHR$(27); CHR$(84);         'SUB/SUPERSCRIPT OFF
  294. 4370 LPRINT CHR$(27); CHR$(87); CHR$(0);  'DOUBLE WIDE CHAR OFF
  295. 4375 LPRINT CHR$(27); CHR$(45); CHR$(0);  'UNDERLINING OFF
  296. 4380 '
  297. 4385 RETURN
  298. 4390 '
  299. 4398 '*****************************************************************
  300. $(0);  'UNDERLINING OFF
  301. 4380 '
  302. 4385